home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-java.el < prev    next >
Encoding:
Text File  |  1995-08-29  |  15.2 KB  |  410 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-java.el
  4. ;; SUMMARY:      Support routines for Java inheritance browsing.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     c, oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    01-Aug-95
  12. ;; LAST-MOD:     26-Aug-95 at 14:43:16 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. ;;; ************************************************************************
  23. ;;; Other required Elisp libraries
  24. ;;; ************************************************************************
  25.  
  26. (mapcar 'require '(br-lib hypb hasht))
  27.  
  28. ;;; ************************************************************************
  29. ;;; User visible variables
  30. ;;; ************************************************************************
  31.  
  32. (defvar java-class-keyword
  33.   "\\(class\\|interface\\)[ \t\n]+"
  34.   "*Keyword regexp preceding a java class declaration or definition.")
  35.  
  36. (defvar   java-lib-search-dirs nil
  37.   "List of directories below which java Library source files are found.
  38. Subdirectories of Library source are also searched.  A Library is a stable
  39. group of classes.")
  40.  
  41. (defvar   java-sys-search-dirs nil
  42.   "List of directories below which java System source files are found.
  43. Subdirectories of System source are also searched.  A System class is one
  44. that is not yet reusable and is likely to change before release.")
  45.  
  46. (defvar java-package-name nil
  47.   "Name of current packge if any.  Nil otherwise.")
  48.  
  49. (defconst java-narrow-view-to-class nil
  50.  "*Non-nil means narrow buffer to just the matching class definition when displayed.")
  51.  
  52. ;;; ************************************************************************
  53. ;;; Internal functions
  54. ;;; ************************************************************************
  55.  
  56. (defun java-get-classes-from-source (filename &optional skip-tags
  57.                      skip-tags-cleanup)
  58.   "Scans FILENAME and returns cons of class list with parents-class alist.
  59. Handles multiple inheritance.  Assumes file existence and readability have
  60. already been checked.
  61.    With optional SKIP-TAGS non-nil, does not compute and store lookup tags
  62. for member definitions.  If SKIP-TAGS is nil, normally a cleanup
  63. function is called after scanning the members.  SKIP-TAGS-CLEANUP
  64. non-nil suppresses this action."
  65.   (let ((no-kill (get-file-buffer filename))
  66.     class-name-end classes class has-parents open-brace-point end
  67.     parents-start parents parent-cons parent-list signatures)
  68.     (setq no-kill nil)
  69.     (if no-kill
  70.     (set-buffer no-kill)
  71.       (funcall br-view-file-function filename))
  72.     ;; Don't bother saving anything for this temporary buffer
  73.     (buffer-disable-undo (current-buffer))
  74.     (setq buffer-auto-save-file-name nil)
  75.     ;; Make life simpler
  76.     (br-lang-mode)
  77.     ;; Static initializers confuse the parser and don't define anything
  78.     ;; that we need, so remove them.
  79.     (java-strip-static-code)
  80.     ;; Is more than one package statement allowed?
  81.     (java-get-package-name)
  82.     (save-excursion
  83.       (save-restriction
  84.     (widen)
  85.     (goto-char (point-min))
  86.     (while (re-search-forward java-class-def-regexp nil t)
  87.       (setq has-parents
  88.         (not (= ?{ (char-after
  89.                 (match-beginning java-class-def-derived-grpn))))
  90.         parents-start (match-beginning java-class-def-derived-grpn)
  91.         end (match-end 0)
  92.         class-name-end (match-end java-class-def-name-grpn)
  93.         ;;
  94.         ;; Now since we've saved all the match expressions we need
  95.         ;; from our last regexp match, we can call functions which
  96.         ;; change the match data below here.
  97.         class (java-normalize-class-match))
  98.       (goto-char parents-start)
  99.       (setq parent-list (if has-parents
  100.                 ;; Return parents as a list.
  101.                 (java-scan-parents end)))
  102.       (if (and (null parent-list)
  103.            (not (equal class "Object")))
  104.           ;; All classes have Object as an ancestor, so if
  105.           ;; no parents are listed, make Object the sole parent.
  106.           (setq parent-list '("Object")))
  107.       ;; Ensure class name not found within a comment
  108.       (if (c-within-comment-p)
  109.           (progn (search-forward "*/" nil t)
  110.              (setq class nil parent-cons nil))
  111.         (setq parent-cons (cons parent-list class)
  112.           classes (cons class classes)
  113.           parents (cons parent-cons parents))
  114.         (or skip-tags
  115.         ;; Scan members defined within class
  116.         (progn (goto-char class-name-end)
  117.                (if (search-forward "{" nil t)
  118.                (progn (setq open-brace-point (point))
  119.                   (backward-char)
  120.                   ;; Move to class close brace but ignore
  121.                   ;; any error if braces are unbalanced.
  122.                   ;; Let the compiler tell the user about
  123.                   ;; this.
  124.                   (if (condition-case ()
  125.                       (progn (forward-sexp) t)
  126.                     (error nil))
  127.                       (setq signatures
  128.                         (append
  129.                          signatures
  130.                          (java-scan-features
  131.                           class open-brace-point
  132.                           (point)))))))))))))
  133.     (if skip-tags
  134.     nil
  135.       (java-get-feature-tags buffer-file-name (java-sort-features signatures))
  136.       (or skip-tags-cleanup (br-feature-tags-save)))
  137.     (or no-kill
  138.     (progn (set-buffer-modified-p nil)
  139.            (kill-buffer (current-buffer))))
  140.     (cons classes (delq nil parents))))
  141.  
  142. (defun java-get-package-name()
  143.   "Return the package name of the current file."
  144.   (save-excursion
  145.     (setq java-package-name nil)
  146.     (goto-char (point-min))        ;; narrowed?
  147.     (if (re-search-forward java-package-name-regexp)
  148.     (setq java-package-name (buffer-substring
  149.                 (match-beginning java-package-name-grpn)
  150.                 (match-end java-package-name-grpn)))
  151.       )))
  152.                 
  153.  
  154. (defun java-split-identifier (name)
  155.   "Return list of component words (in reverse order) of the given NAME."
  156.   (or (hash-lookup name java-package-htable)
  157.       (let ((s name)
  158.         start words tmp)
  159.     (while (and (not (null s)) (> (length s) 0))
  160.       (setq start (string-match java-package-word-regexp s))
  161.       (if start
  162.           (progn
  163.         (setq tmp (substring s (match-beginning 1) (match-end 1)))
  164.         (setq s (substring s (match-end 0)))
  165.         (setq words (cons tmp words)))))
  166.     (hash-add words java-package-name java-package-htable))))
  167.  
  168. (defun java-normalize-class-name (name)
  169.   "Convert class NAME to make it globally unique using current package."
  170.   ;; Currently incomplete.  THe defined class has a package name, but
  171.   ;; the parents do not.  How do we match the parents to the correct
  172.   ;; class if there are multiple matches?
  173.   (or (car (java-split-identifier name))
  174.       (if (null java-package-name)
  175.       (car (java-split-identifier name))
  176.     ;; Note: maybe allow user to pick how many words to prepend.
  177.     (let ((prefix (car (java-split-identifier java-package-name))))
  178.       (if (and prefix (> (length prefix) 0))
  179.           (concat prefix "." (car (java-split-identifier name)))
  180.         (car (java-split-identifier name)))))))
  181.  
  182. (defun java-class-definition-regexp (class &optional regexp-flag)
  183.   "Return regexp to uniquely match the definition of CLASS name.
  184. Optional REGEXP-FLAG non-nil means CLASS has already been quoted for use in a
  185. regular expression."
  186.   (concat "[ \t]*"
  187.       java-class-keyword
  188.         (if regexp-flag
  189.         class
  190.           (regexp-quote class))
  191.         java-class-name-after))
  192.  
  193. (defun java-normalize-class-match ()
  194.   "After a regexp match to a class definition, return the matching class name."
  195.     (java-normalize-class-name
  196.      (buffer-substring (match-beginning java-class-def-name-grpn)
  197.             (match-end java-class-def-name-grpn))))
  198.  
  199. (defun java-scan-parents (end)
  200.   "Return list of parent names from a java class definition.
  201. Since java permits only single inheritance, the list will include at most one
  202. parent name.  Point must be before the implements or extends keyword that
  203. precedes the parent class name."
  204.   (let (parent-list parent)
  205.     (while (re-search-forward java-parent-regexp end t)
  206.       (setq parent (java-normalize-class-name
  207.              (buffer-substring (match-beginning java-parent-name-grpn)
  208.                        (match-end java-parent-name-grpn)))
  209.         parent-list (cons parent parent-list)))
  210.     (nreverse parent-list)))
  211.  
  212. (defun java-get-parents-from-source (filename class-name)
  213.   "Scan source in FILENAME and return list of parents of CLASS-NAME.
  214. Assume file existence has already been checked."
  215.     (cond ((null class-name) nil)
  216.       ((equal filename br-null-path)
  217.        ;; This means there is no source for this class, so 
  218.        ;; since all classes have Object as an ancestor and there is no
  219.        ;; where to look for parents, make Object the sole parent.
  220.        '("Object"))
  221.       (t (let ((br-view-file-function 'br-insert-file-contents))
  222.            (car (car (br-rassoc
  223.               class-name
  224.               (cdr (java-get-classes-from-source
  225.                 filename t)))))))))
  226.  
  227. (defun java-select-path (paths-htable-elt &optional feature-p)
  228.   "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
  229. Selection is between path of class definition and path for features associated
  230. with the class."
  231.   (let ((elt (cdr paths-htable-elt)))
  232.     (if (consp elt) 
  233.     (if feature-p (cdr elt) (car elt))
  234.       ;; Both paths are the same.
  235.       elt)))
  236.  
  237. (defun java-set-case (type)
  238.   "Return string TYPE identifier for use as a class name."
  239.   type)
  240.  
  241. (defun java-set-case-type (class-name)
  242.   "Return string CLASS-NAME for use as a type identifier."
  243.   class-name)
  244.  
  245. (defun java-to-class-end ()
  246.   "Assuming point is at start of class, move to start of line after end of class."
  247.   (interactive)
  248.   (condition-case ()
  249.       (forward-list)
  250.     (error (progn (or (re-search-forward "^}" nil t)
  251.               (goto-char (point-max))))))
  252.   (forward-line 1))
  253.  
  254. (defun java-to-comments-begin ()
  255.   "Skip back from current point past any preceding blank lines and comments.
  256. Presumes no \"/*\" strings are nested within multi-line comments."
  257.   (let ((opoint))
  258.     (while (progn (setq opoint (point))
  259.           ;; To previous line
  260.           (if (= 0 (forward-line -1))
  261.               (cond
  262.                ;; If begins with "//" or ends with "*/", then is a
  263.                ;; comment.
  264.                ((looking-at "[ \t]*\\(//\\|$\\)"))
  265.                ((looking-at ".*\\*/[ \t]*$")
  266.             (end-of-line)
  267.             ;; Avoid //*** single line comments here.
  268.             (re-search-backward "\\(^\\|[^/]\\)/\\*" nil t))
  269.                ((looking-at "[ \t]*$"))))))
  270.     (goto-char opoint)
  271.     ;; Skip past whitespace
  272.     (skip-chars-forward " \t\n")
  273.     (beginning-of-line)))
  274.  
  275. ;; Static initializers confuse the parser, and don't define anything
  276. ;; that we need
  277. (defun java-strip-static-code ()
  278.   "Strip the static initializers from this buffer."
  279.   (let (buffer-read-only)
  280.     (save-excursion
  281.       (goto-char (point-min))
  282.       (while (re-search-forward java-static-init-regexp (point-max) t)
  283.     (goto-char (1- (match-end 0)))
  284.     (let ((start (point)))
  285.       (if (= (following-char) ?{)
  286.           (condition-case ()
  287.           (forward-sexp)
  288.         (error nil)))
  289.       (delete-region start (point))
  290.       (delete-region (match-beginning 0) (1- (match-end 0)))
  291.       )))))
  292.  
  293. ;;; ************************************************************************
  294. ;;; Internal variables
  295. ;;; ************************************************************************
  296.  
  297. (defconst java-class-modifier-keyword
  298.   "\\(public\\|protected\\|final\\|abstract\\|[ \t\n\^M]+\\)*")
  299.  
  300. (defconst java-class-name-before
  301.   (concat "^[ \t]*" java-class-modifier-keyword java-class-keyword)
  302.   "Regexp preceding the class name in a class definition.")
  303.  
  304. (defconst java-class-name-after
  305.   "[ \t\n]+\\({\\|extends\\|implements\\)"
  306.   "Regexp following the class name in a class definition.
  307. Last character matched is either the colon preceding the list of class
  308. parents, or the curly brace beginning the class body definition.")
  309.  
  310. (defconst java-identifier-chars "_$.a-zA-Z0-9"
  311.   "String of chars and char ranges that may be used within a java or G++ identifier.")
  312.  
  313. (defconst java-return-type-chars java-identifier-chars
  314.   "String of chars and char ranges that may be used within a java or G++ return type identifier.")
  315.  
  316. (defconst java-identifier (concat "\\([_$a-zA-Z][" java-identifier-chars "]*\\)")
  317.   "Regular expression matching a java or G++ identifier.")
  318.  
  319. (defconst java-class-def-regexp
  320.   (concat java-class-name-before java-identifier java-class-name-after
  321.       "[^{(;]+")
  322.   "Regular expression used to match to class definitions in source text.
  323. Class name identifier is grouping 'java-class-def-name-grpn'. 
  324. ':' derived class indicator begins grouping 'java-class-def-derived-grpn,'
  325. unless the class is not derived, in which case this grouping begins with
  326. '{'.")
  327.  
  328. (defconst java-class-def-name-grpn 3)
  329. (defconst java-class-def-derived-grpn 4)
  330.  
  331. (defconst java-lang-prefix "java-"
  332.  "Prefix string that starts \"br-java.el\" symbol names.")
  333.  
  334. (defconst java-parent-regexp
  335.   (concat "\\(\\(implements\\|extends\\|,\\)?[ \t\n]+\\)*[ \t\n]+"
  336.       java-identifier "[ \t\n]*[ {;]")
  337.   "Parent identifier is group 'java-parent-name-grpn'.")
  338. ;; part 2 of original
  339. ;;      "\\(\\(public\\|private\\|protected\\|final\||abstract\\|implements\\|extends\\)[,]?[ \t\n]+\\)?\\)?"
  340.  
  341. (defconst java-parent-name-grpn 3)
  342.  
  343. (defconst java-package-name-regexp
  344.   (concat "[ \t\n]*" java-identifier "[ \t\n]*;")
  345.   "Regexp matching a package statement.  Package name is java-package-name-grpn.")
  346.  
  347. (defconst java-package-name-grpn 1)
  348.  
  349. (defconst java-package-word-regexp
  350.   "\\([a-zA-z_0-9]*\\)\\.?"
  351.    "Return a single component of a package name.")
  352.  
  353. (defconst java-static-init-regexp
  354.   "[ \t\n]*static[ \t\n]+{"
  355.   "Regexp matching start of static initializer block.")
  356.  
  357. (defvar java-package-htable
  358.   (hash-make 7)
  359.   "Hash table of split package names.")
  360.  
  361. (defconst java-file-dir-regexp "^[^.~#].*[^.~#]$"
  362.   "Regexp that ignores extraneous non-source files and directories.")
  363.  
  364. (defconst java-src-file-regexp "[^.]\\.\\(java\\)$"
  365.   "Regular expression matching a unique part of java source or header file name and no others.")
  366.  
  367. (defvar java-children-htable nil
  368.   "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
  369. Used to traverse java inheritance graph.  'br-build-children-htable' builds
  370. this list.")
  371. (defvar java-parents-htable nil
  372.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  373. Used to traverse java inheritance graph.  'br-build-parents-htable' builds
  374. this list.")
  375. (defvar java-paths-htable nil
  376.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  377. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  378. 'br-build-paths-htable' builds this list.")
  379.  
  380.  
  381. (defvar java-lib-parents-htable nil
  382.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  383. Only classes from stable software libraries are used to build the list.")
  384. (defvar java-lib-paths-htable nil
  385.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  386. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  387. Only classes from stable software libraries are used to build the list.")
  388.  
  389. (defvar java-sys-parents-htable nil
  390.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  391. Only classes from systems that are likely to change are used to build the
  392. list.")
  393. (defvar java-sys-paths-htable nil
  394.   "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  395. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  396. Only classes from systems that are likely to change are used to build the
  397. list.")
  398.  
  399. (defvar java-lib-prev-search-dirs nil
  400.   "Used to check if 'java-lib-classes-htable' must be regenerated.")
  401. (defvar java-sys-prev-search-dirs nil
  402.   "Used to check if 'java-sys-classes-htable' must be regenerated.")
  403.  
  404. (defvar java-env-spec nil
  405.   "Non-nil value means Environment specification has been given but not yet built.
  406. Nil means current Environment has been built, though it may still require
  407. updating.")
  408.  
  409. (provide 'br-java)
  410.